#|___________________________________________________________________ 
 | 
 | ViSta - The Visual Statistics System
 | Copyright (c) 1991-2001 by Forrest W. Young
 | For further information contact the author 
 | Web Site: http://www.visualstats.org/
 | Email:    listener@visualstats.org
 | News:     news@visualstats.org
 |
 | defun0.lsp
 |
 | This file contains functions that are needed
 | at the very beginning by maker.lsp and statinit.lsp,
 | including please-wait, several main window functions, and
 | the xlispstat-only functions.
 | some of these are replaced by other versions later.
 |___________________________________________________________________ 
 |# 

#|___________________________________________________________________ 
 | 
 | xlispstat-only functions
 |
 | These functions switch between the regular vista state 
 | and the xlispstat-only state.
 |
 | DO NOT CHANGE THESE FUNCTIONS. 
 | THEIR STRANGE STRUCTURE IS PART OF THEIR CHARM ---
 | AND THEY DON'T WORK RIGHT IF CHANGED.
 |___________________________________________________________________ 
 |# 
(setf *devel-mode* t)
(setf *vista-name*    "ViSta: The Visual Statistics System")
(setf *vista-website* "  web: www.visualstats.org")
(setf *email*         "email: listener@visualstats.org")
(setf *vista-news*    " news: news@visualstats.org")
(setf *vista-bugs*    " bugs: bugs@visualstats.org")
(setf *www-visualstats.org* "www.visualstats.org")
(setf *vista-url* "http://www.visualstats.org/vista-frames/")
(setf *vista-email* *email*)

(defun showbugs () (listeners))

(defun current-datasheet-window () (current-datasheet))
(defun current-report-window () (current-report))
(defun current-spreadplot-window () (spreadplot-window))

(defun initial-environment (&key (desktop nil) (logo nil) (viva nil) (datasheet) (verbose nil) (debug nil) (log nil))
"Args: (&key (desktop nil) (logo nil) (viva nil) (verbose nil) (debug nil) (log nil))
Configures Vista's initial environment. The environment can include displaying the LOGO and DESKTOP, showing DATASHEETS whenever data are created, and running VIVA in the listener. For applet development, the environment can be in DEBUG mode, with VERBOSE messages, and a LOG can be kept."
  (setf *xlisponly* nil)
  (send *logo* :idle-on logo)
  (setf *viva* viva)
  (setf *hide-vista* (not desktop))
  (setf *hide-logo* (not logo))
  (setf *show-datasheet-after-loading-data* datasheet)
  (create-vista :hide-vista *hide-vista*  :hide-logo *hide-logo*)
  (verbose verbose log)
  (debug-mode debug)
  )


(defun xlispstat-only (logical)
    (setf *xlispstat-only* logical)
    (msw-write-profile-string 
     "ViSta" "XLispOnly" (if logical "Yes" "No") *ini-file*)
    (set-working-directory *default-path*)
    (system "vista.exe")
    (exit))

(setf *statinit-verbose* nil)
(setf *please-wait* nil)

 (defun replace-dash-with-dot (str)
"Args: string
Replaces dashes in strings with dots. Used to construct variable names that work with ViVa"
    (let ((i (position  #\- str :test #'equal)))
      (if i (setf (select str i) #\.))
      str))

(defun replace-dash-with-underscore (str)
"Args: string
Replaces dashes in strings with underscores. Used to construct variable names that work with ViVa"
    (let ((i (position  #\- str :test #'equal)))
      (if i (setf (select str i) #\_))
      str))

(defun xlisp () 
"Args: none
Does nothing until ViSta has been loaded with the (vista) function."
  t)

(defun vista ()
"Args: none
When in XLispOnly-mode, loads ViSta and causes both XLispStat and ViSta to load in normal XLisp/ViSta-mode in the future."
  (setf *xlispstat-only* nil)
  (msw-write-profile-string "ViSta" "XLispOnly" "No" *ini-file*)
  (hidemainwindow)
  (load-vista)
 ; (format t "Type (xlisp) to run XLispStat without ViSta.~%")
 ; (format t "Type (viva)  for ViSta's Interactive Variable Algebra Language.~2%")
  )

(defun load-xlisp ()
  (defaultmainwindow)
  (setf *xlispstat-only* t)
  (format t "~a~%" *xls-mod-copyright*)
  (FORMAT T "; Type (vista) to run ViSta.~2%")
  (top-level nil))


(defun check-xlisponly ()
  (if *vista*
      (list
       (msw-get-profile-string 
                "ViSta" "XLispOnly" (strcat (get-working-directory) "\\wxls32.ini"))
       (send *vista* :show-load-vista)
       *xlispstat-only*)
      (list
       (msw-get-profile-string 
                "ViSta" "XLispOnly" (strcat (get-working-directory) "\\wxls32.ini"))
       *xlispstat-only*)))


(defun load-vista ()
  (cond
    ((and (boundp '*statinit-maker-error-flag*) *statinit-maker-error-flag*)
     (listeners)
     (please-wait "CASE UNEVALUATED: TRAPPING ABNORMAL MAKER EXIT" 
                  :title "INSTALL VISTA" :show-time 2)
     (top-level))
    ((not (boundp '*vista-start-case*))
     (listeners)
     (please-wait "CASE UNBOUND: TRAPPING ABNORMAL MAKER EXIT" 
                  :title "INSTALL VISTA" :show-time 2)
     (top-level))
    ((not *vista-start-case*)
     (listeners)
     (please-wait "CASE NIL: TRAPPING ABNORMAL MAKER EXIT" 
                  :title "INSTALL VISTA" :show-time 2)
     (top-level))
    ((case *vista-start-case*
       (0 (when *statinit-verbose*
                (please-wait (format nil "CASE 0: RETAIN PREVIOUS VISTA") 
                             :pause 60 :title "INSTALL VISTA"))
          (cond
            ((probe-file "xlisp.bak")
             (rename-file "xlisp.bak" "xlisp.wks")
             (format t "; renamed xlisp.bak -> xlisp.wks ~%"))
            (t (format t "; statinit: no xlisp.bak or xlisp.wks file. sol"))))
       (1 (when *statinit-verbose*
                (please-wait "CASE 1: SAVE UNLOCALIZED WORKSPACE FOR DOWNLOAD INSTALL"
                             :title "INSTALL VISTA" :pause 60 ))
          (setf *vista-start-case* 3)
          (save-workspace "xlisp"))
       (2 (when *statinit-verbose*
                (please-wait "CASE 2: SAVE UNLOCALIZED WORKSPACE FOR LOCAL INSTALL"
                             :title "INSTALL VISTA" :pause 60))
          (setf *vista-start-case* 9)
          (save-workspace "xlisp"))
       (3 (when *statinit-verbose*
                (please-wait "CASE 3: LOCALIZE AND INSTALL UNLOCALIZED WORKSPACE AFTER DOWNLOAD"
                             :title "INSTALL VISTA" :pause 60))
          (setf *vista-start-case* 9)
          (install-vista)
          (setf *vista-start-case* 9))
       (8 (when *statinit-verbose* 
                (please-wait "CASE 8: MAKE VISTA COMPILER ERROR - RECOMPILATION ATTEMPTED"
                             :title "Make ViSta" :pause 60 )
                (send *please-wait* :remove)
                (compile-vista-file *compiler-error-file*)
                (jump-start)))
       (9 (when *statinit-verbose* 
                (please-wait "CASE 9: RUN LOCALIZED WORKSPACE"
                             :title "INSTALL VISTA" :pause 60 )
                (send *please-wait* :remove))
          (load "runtime\\vista"))
       (t (when *statinit-verbose* 
                (please-wait "CASE INVALID: TRAPPING UNKNOWN THREAD" 
                             :title "INSTALL VISTA" :pause 60 )
                (send *please-wait* :remove))
          (top-level)(top-level))));cond branch
    (t (when *statinit-verbose* 
            (please-wait "CONDITION INVALID: TRAPPING UNKNOWN THREAD" 
                              :title "INSTALL VISTA" :pause 60 )
            (send *please-wait* :remove))
       (top-level)(top-level))))

(defun probe-init ()
  (when (probe-file "init.tmp")
        (error-message "Forrest: StatInit needs attention. Is INIT.TMP used?")
        (listeners) (break)
        (rename-file "init.tmp" "init.lsp")
        (format t "; renaming init.tmp -> init.lsp~%"))
  )

(defun jump-start ()
  (set-working-directory *default-path*)
  (delete-file "xlisp.wks")
  (system "vista.exe")
  (exit))

(defun verbose-restart ()
  (verbose t)
  (restart-vista))

(defun quiet-restart ()
  (verbose nil)
  (restart-vista))
  
(defun debug-options ()
  (let* ((dialog))
    (setf dialog
          (choice-item-dialog 
           (format nil "RUNTIME ERROR~%Choose an Action:")
           (reverse (list 
             "(remove-dialog)" "(listeners)" "(quiet-restart)" "(verbose-restart)"
             "(make-vista)" "(jump-start)" "(exit)" 
              ))
           (reverse (list 
            '(remove-me) '(listeners) '(quiet-restart) '(verbose-restart)
             '(make-vista) '(jump-start) '(exit)
            ))
           :title "Debug Options"))
    (defun remove-me () (send dialog :remove))
    t))

(setf *show-make-steps?* t )

#|
  (defun load-and-verify-with-restore-pref-files ()
    (let* ((initfile (strcat "prefs" *separator* "initial.lsp"))
           (preffile  (strcat "prefs" *separator* "prefload.lsp"))
           )
    (cond 
      ((probe-file initfile) 
       (load initfile)
       (format t "; GeneSys already written~%"))
      (t
       (message-dialog "GeneSys ReCreating Initial State")
       (format t "; GeneSys ReCreating Initial State~%")
       (setf *prefs-dir-name* (strcat *default-path* "prefs" *separator*))
       (setf *genesys* t)
       (load  (strcat "genesys" *separator* "prefs\\initial.lsp"))))
    (cond 
      ((probe-file preffile) (load preffile))
      (t
       (load (strcat "genesys" *separator* "prefs\\prefload.lsp"))
       (file-to-file (strcat "genesys" *separator* "prefs\\prefs.lsp")
                     (strcat "prefs\\prefs.lsp"))
       (file-to-file (strcat "genesys" *separator* "prefs\\workmap.lsp")
                     (strcat "prefs\\workmap.lsp"))
       (file-to-file (strcat "genesys" *separator* "prefs\\desktop.lsp")
                     (strcat "prefs\\desktop.lsp"))
       ))))
|#


(defun load-and-verify-with-restore-pref-files ()
  (format t "; old load-and-verify shouldn't be called")
  (top-level))


(defun probe-file-length (file)
"Arg: File name
Returns the byte-length of FILE when FILE exists, NIL if it does not."
  (when (probe-file file)
        (with-open-file (f file) (file-length f))))


(defun one-button-dialog 
  (text &key (first-button "OK") (title "Dialog"))
"Args: TEXT &KEY (FIRST-BUTTON \"OK\") (TITLE \"DIALOG\")"
  (let* ((text (send text-item-proto :new text))
         (ok (send modal-button-proto :new first-button
                   :action #'(lambda () t)))
         (dialog (send modal-dialog-proto :new 
                       (list text ok)
                       :title title
                       :default-button ok)))
    (send dialog :modal-dialog)))

(defun failsafe-load (path file &key (verbose *load-verbose*) (print nil) (retry nil)
                           (if-does-not-exist nil))
"Args: path file &key (verbose *load-verbose*) (print nil) (if-does-not-exist nil)
Attempts to load FILE that is expected to be in PATH. If file is not found or is zero length, issues warning and then attempts to load FILE from FAILSAFE directory. If that fails issues termination message and exits. ARGS are the same arguments as the arguments of the LOAD function."
  
  (when (or (not (boundp '*load-verbose*)) *load-verbose*) (format t "; [FailSafe] "))
  (let ((result (probe-file-length (strcat path file))))
    (cond 
      ((or (not result) (= result 0))
       (cond 
         (retry
          (one-button-dialog  (format nil "FAILSAFE FAILURE:~%FAILSAFE FAILED TO FIND BACKUP FILE:~2%Contact bugs@visualstats.org")
                              :title "FAILSAFE FILELOADER FAILURE") (exit))
         (t
          (one-button-dialog  (format nil "FILE ~a IS ~a [length: ~d].~%Path: ~a.~%Looking for BackUp.~2%If problem persists, contact bugs@visualstats.org" 
                                     (string-upcase file) (if result "CORRUPT" "MISSING") result path)
                              :title "FAILSAFE FILELOADER WARNING")
          
          (failsafe-load (strcat *default-path* "genesys\\") file 
                         :print print :verbose verbose :retry t
                         :if-does-not-exist if-does-not-exist))))
      (t
       (load (strcat path file) :verbose verbose :print print
             :if-does-not-exist if-does-not-exist)
       ))))


(defun make-vista-run-number ()
  (make-vista-id-number)
  *vista-run-number*)

(defun make-vista-id-number ()
  (setf *update-id* 
        (strcat  *phase0-id* *phase1-id* *phase2-id* *phase3-id* *phase4-id* ))
  (setf *vista-run-number* 
        (format nil "~d.~d.~d.~d.~d.~d"
                *log-number* *load-number* *build-number* 
                *run-number* *local-install-number* *update-id*))
  (setf *vista-id-number* 
        (strcat *release-number* 
                (format nil ".~a" (select *RELEASE-LANGUAGE* 0)) 
                #+msdos "W" #+macintosh "M" #+unix "U" 
                (if *pro-version* "D" "U") "."
                *vista-run-number*))
  (setf *vista-id* *vista-id-number*))

(defun vista-id-number () (make-vista-id-number))

(defun make-version ()
  (make-vista-id-number)
  (setf *invoked-date* (date))
  (setf *version*
        (format nil "ViSta ID .... ~a~%Run Number .. ~a~%Registration  ~a~%Compiled .... ~a~%Built ....... ~a~%Distributed . ~a~%Installed ... ~a~%Invoked ..... ~a~%Current ..... ~a~2%"
          *vista-id-number* *vista-run-number* *registration-number* *compile-date* *build-date* *distribution-date* *install-date* *invoked-date* (date))))

(defun version ()
  (make-version)
  (format t "~a" *version*)
  t)
(defun zero-button-dialog (text &optional title &key (width 400) (pause 0))
"Args: TEXT"
  (let* ((text (send text-item-proto :new text :size '(350 120)))
         (dialog (send dialog-proto 
                       :new (list text) 
                       :title (if title (string-upcase title) " ")
                       :size (list width 40))))
    (pause pause)
    dialog))


(defun please-wait (text &key (pause 0) (close nil) (show-time nil) (lines 1) (title "Please Wait") (width 400) )
"Args: text &key (pause 0) (show-time nil) (close nil) (lines 1) (title \"PLEASE WAIT\") (width 400)
Displays text in a button-less modeless dialog box for SHOW-TIME (in seconds) after an initial time of PAUSE  (in number of 60ths of a second). By default will show forever and will not be closable. Must be sent the :remove message to remove, unless :close is t, in which case the close box will close it."
  
  (when (not (boundp '*please-wait*)) 
        (setf *please-wait* nil)
        (setf *please-waiter* nil))
  (when *please-waiter*
        (setf *please-wait* *please-waiter*))
  (if *please-wait* 
      (send (first (send *please-wait* :items)) :text text)    
      (progn
       (setf *please-wait* (zero-button-dialog text title 
                                               :width width :pause pause))
       (setf *please-waiter* *please-wait*)))
  (defmeth *please-wait* :text () 
    (send (first (send self :items)) :text text))
  (send *please-wait* :text)
  (send *please-wait* :title title)
  (defmeth *please-wait* :remove () 
    (call-next-method) 
    (setf *please-wait* nil))
  (if close 
      (defmeth *please-wait* :close ()
        (send self :remove))
      (defmeth *please-wait* :close ()))
  (apply #'send *please-wait* :size (list width (+ 26 (* lines 14))))
  (send *please-wait* :show-window)
  (when pause (pause pause))
  (when show-time
        (defmeth *please-wait* :loop (start-time)
          (let ((current-time))
            (loop
             (setf current-time (get-internal-real-time))
             (when (> (- current-time start-time) (* 60 show-time) )
                   (return)))
            (send *please-wait* :remove)))
        (send *please-wait* :loop (get-internal-real-time)))
  *please-wait*)


(defun probe-vista-file (file)
  (probe-file file)
  )
  
(when (probe-file "xlisp.wks")
      (rename-file "xlisp.wks" "xlisp.bak")
      (setf renamed-wks t)
      (format t "; renamed xlisp.wks -> xlisp.bak ~%")
      (system (strcat *default-path* "vista.exe -f maketime\\maker.lsp"))
      (exit))

(defun rename-vista-file (inname outname)
  (cond
    ((probe-vista-file inname)
     (rename-file inname outname)
     (format t "; renamed ~a -> ~a ~%" inname outname)
     t)
    (t
     (format t "; cannot rename vista file ~a. does not exist.~%" inname)
     nil)))

(defun open-window 
    (&optional (cant-b-x 4) (y 24) 
               (w (first (effective-screen-size))) 
               (h (second (effective-screen-size))))
  (hidemainwindow)
  (mainwindow cant-b-x y  w h)
  (showmainwindow)
  (listener 2 0 w (- h 20)))

(defun listeners (&key (micro nil))
  (let* ((x (first (effective-screen-size)))
         (mid-x (floor (/ x 2)))
         (h (if micro 100 250))
         (w mid-x))
    (setf *need-second-listener* nil)
    (cond
      ((and (boundp '*listener*) *listener*) 
       (setf *need-second-listener* nil)
       (send *listener* :hide-window)
       (send *listener* :location (+ w 4) 24)
       (send *listener* :size (- w 8) (- h 28))
       (send *listener* :show-window)
       (send *listener* :pop-out t))
      (t
       (setf w x)
       (if micro (setf w mid-x))
       (setf *need-second-listener* t)))
    (hidemainwindow)
    (mainwindow 4 24 w h)
    (listener 0 0 w (- h 18))
    (showmainwindow)
    ))

(defun frontmainwindow (&optional x y w h)
  (hidemainwindow)
  (if (and x y w h)
      (mainwindow x y w h))
  (showmainwindow))

(defun maxmainwindow () (open-window))
(defun max-mainwindow () (open-window))
(defun front-mainwindow (&rest args) (apply #'frontmainwindow args))
(defun show-mainwindow () (showmainwindow))
(defun hide-mainwindow () (hidemainwindow))


(defun xlispstat-window (&key (viva nil))
  (hidemainwindow)
  (defaultmainwindow); fwy added following clause 09-23-02
  (when (and (boundp '*show-xlispstat-window-item*)
             (not (not *show-xlispstat-window-item*)))
	(send *show-xlispstat-window-item* :mark t))
  (when viva (print-viva-listener-help));fwy added 09-22-02
  ;(when (and (not *main-menubar*) *devel-mode*) (main-menubar))
  )

;(defun both-listeners () (listeners))

(defun listener2 (&key (location '(50 50)) (size '(480 240)))
  (unless (and (boundp '*listener*) *listener*)
          (let ((c (send container-proto :new 2 :show nil)))
            (enable-container c)
            (setf *listener* (send listener-proto :new)))
          )
  (send *listener* :pop-out t)
  (send *listener* :no-move nil)
  (defmeth *listener* :top-most ()
    (send *listener* :hide-window) ;with next statement equals top-most
    (send *listener* :show-window)) ;for which there isnt othrwise
  (send *listener* :top-most)
  (apply #'send *listener* :location location)
  (apply #'send *listener* :size size)
  *listener*
  )

(defun open-dialog-window (&optional (width 432) (height 322))
  (let* ((max-w (first (screen-size)))
         (max-h (second (screen-size)))
         (w width)
         (h height)
         (cant-b-x (+ 4 (round (/ (- max-w w) 2))))
         (y (+ 34 (round (/ (- max-h h) 2)))))
    (open-window cant-b-x y w h)))

(defun defaultmainwindow ()
  (hidemainwindow)
  (mainwindow 40 40 608 448)
  (showmainwindow)
  (apply #'listener (combine 4 24 (- (select (mainwindow) (list 2 3)) (list 8 46))))
  )

(defun openmainwindow (&key (front t))
"Arg (&key (front t))
Opens main window and its listener and pops to front unless front is nil"
  (when front (hidemainwindow))
  (showmainwindow)
   (let ((size-loc (mainwindow)))
     (listener 0 0 (third size-loc) (- (fourth size-loc) 19))))

(defun closemainwindow ()
     (hidemainwindow))

(setf *dribble-on* nil)

(defun double-dribble (&optional file)
"Arg: (&optional file)
When global variable *log-verbose* is NIL, double-dribble does nothing. When T, does following:
If string or symbol FILE is supplied creates a transcript file with this name, unless a file has already been opened.
If FILE is missing closes the transcript file if one is open."
   (when *log-verbose*
    (cond
      (file
       (unless *dribble-on* 
               (dribble file)
               (setf *dribble-on* t)))
      (t (dribble)
         (setf *dribble-on* nil)))))

(setf *main-menubar* nil)

(defun main-menubar ()
  (menubar :in nil))

#|
 | TIME FUNCTIONS
 |#


(defun get-decoded-time-list ()
"Returns decoded time as a list of elements"
     (multiple-value-list (GET-DECODED-TIME)))
(defun date-time ()
  (let* ((list (get-decoded-time-list))
         (month-num (fifth list))
         (month-string
         (case month-num
            (1 "January") (2 "February") (3 "March") (4 "April") (5 "May") (6 "June") 
            (7 "July") (8 "August") (9 "September") (10 "October") (11 "November") 
            (12 "December")))
         (day-num (seventh list))
         (day-of-week
          (case day-num
            (6 "Sunday") (0 "Monday") (1 "Tuesday") (2 "Wednesday") (3 "Thursday")
            (4 "Friday") (5 "Saturday") ))
         (24hour (third list))
         (ampm (if (> 24hour 12) "PM" "AM"))
	(month (select list 4))
	(month (if (< month 10) (format nil "0~a" month) 
                     (format nil "~a" month)))
	(date (select list 3))
	(date (if (< date 10) (format nil "0~a" date) 
                     (format nil "~a" date)))
         (hour (format nil "~a" (if (> 24hour 12) (- 24hour 12) 24hour)))
	 (zerohour (if (< 24hour 10) (format nil "0~a" hour)  hour))
         (minute (second list))
         (minute (if (< minute 10) (format nil "0~a" minute) 
                     (format nil "~a" minute)))
         (second (first list))
         (second (if (< second 10) (format nil "0~a" second) 
                     (format nil "~a" second)))
	(sortdate (strcat 
		(format nil "~a" (select list 5)) "."
 		(format nil "~a" month) "." 
		(format nil "~a" date) "." 
		(format nil "~a" zerohour) "." 
		(format nil "~a" minute) "." 
		(format nil "~a" second)))
         (time12 (format nil "~a:~a ~a" hour minute ampm))
         (time24 (format nil "~a:~a" 24hour minute))
         (time-seconds12 (format nil "~a:~a:~a ~a" hour minute second ampm))
         (time-seconds24 (format nil "~a:~a:~a" 24hour minute second))
         (short-date (apply #'format nil "~a/~a/~a" (select list '(3 4 5))))
         (american-short-date (apply #'format nil "~a/~a/~a" (select list '(4 3 5))))
         (long-date (apply #'format nil "~a ~a, ~a" month-string (select list '(3 5))))
	(short-sortdate (format nil "~a.~a.~a"(select list 5) month date))
         )
    (list long-date time12 day-of-week short-date american-short-date time-seconds12 time24 time-seconds24 short-sortdate sortdate)))
(defun print-date-time ()
  (let ((date-time (date-time)))
    (format t "; ~a, ~a, ~a~%"(third date-time)(first date-time) (second date-time))))

(defun time-stamp (&key (short nil) (sortable nil))
    (let ((var (date-time)))
      (cond 
        (short 
          (setf var (format nil "~a, ~a" (fifth  var ) (eighth var))))
        (sortable
          (setf var (ninth var)))
        (t
          (setf var (format nil "~a, ~a, ~a" 
              (third  var ) (first  var ) (second var )))))))


(defun short-time-stamp ()
    (let ((var (date-time)))
      (setf var (format nil "~a, ~a" (fifth  var ) (eighth var )))))

(defun date () (time-stamp))

#|
 | COPRIGHT FUNCTIONS
 |#


(setf *beta* "ß")
(setf *copyright* "©")

(defun read-version-file ()
(when (and (boundp '*v*) *v*) (format t "; Loading VersionFile"))
(if (and (boundp '*prefs-dir-name*) *prefs-dir-name*)
      (failsafe-load *prefs-dir-name* "version.lsp"
            :direction :input :if-does-not-exist nil)
      (failsafe-load (strcat *default-path* "\\prefs\\") "version.lsp"
            :direction :input :if-does-not-exist nil)))

(defun make-vista-copyright (&optional initial)
  (setf *copyright-string* (format nil "Copyright ~a 1991-~a by Forrest W. Young" *copyright* (sixth (get-decoded-time-list))))
  (setf *version* *release-number*)
  (setf *version-string* 
        (strcat "Version " *release-number* "." (format nil "~d" *build-number*) "." (subseq *release-language* 0 1)
                #+msdos "W" #+macintosh "M" #+X11 "U"
                (if *pro-version* "D " "U ") *release-date*))
  (setf *release* 
        (strcat (subseq *release-language* 0 1)
                #+msdos "W" #+macintosh "M" #+X11 "U"
                (if *pro-version* "D" "U") "."
		(time-stamp :sortable t) "." 
		(format nil "~d" *build-number*)
		))
  (setf *version-string* (format nil "Version ~a (~a)" *version* *release*))
  (setf *vista-release-number* *release-number*)
  (setf *vista-copyright*
        (format nil "~a~%~a~%~a"  *vista-name*
               (if initial (strcat "> " *copyright-string*) *copyright-string*)
               (if initial (strcat "> " *version-string*) *version-string*)))
  (list *vista-name* *copyright-string* *version-string*))

(defun vista-copyright (&optional use nl skip-line id initial)
"Args: &optional use nl skip-line id initial
USE includes runnumber with details. NL is number of lines to print on."
  (read-version-file)
  (make-vista-copyright initial)
  (unless nl (setf nl 3))
  (when (or (< nl 1) (> nl 4)) (setf nl 3))
  (unless skip-line (format t "~%"))
  (case nl
    (1 (format t "~a" (strcat *vista-name* " - " *copyright-string*)))
    (2 (format t "~a (~a)~%~a~a" *vista-name* *short-version-string*  
       (if initial "> " "") *copyright-string*))
    (2 (format t "~a" (strcat *vista-name* "    - " *copyright-string*))
       (if initial (format t "~%>  ") );(format t "~%")
       (format t "~%~a" (strcat  *version-string*  " - Run on " (date))))
    (3 (if use (format t "~a (~a) " *vista-copyright* use)
           (format t "~a" *vista-copyright*)))
    (4 (format t "~a (~a)~%~a" *vista-copyright* use *vista-website*))
    )
  (when id (format t " ~a" id))
  (when (boundp '*num-listener-lines* )
        (when (> *num-listener-lines* 3) (format t "~%")))
  (case nl
    (1  (list  *vista-name* " - " *copyright-string*))
    (2  (list *vista-name* *copyright-string*))
    (3  (list *vista-name* *copyright-string*
              (if use (format nil "~a (~a)" *version-string*  use)
                  *version-string*)))
    (4  (list *vista-name* *copyright-string* 
              (if use (strcat *version-string* " (" (format nil "~a" use) ")"))
              *vista-website*))
    ))

(defun xls-copyright ()
  (let* ((line1 "XLISP-PLUS version 3.04")
         (line2 "Portions Copyright (c) 1988, by David Betz.")
         (line3 "Modified by Thomas Almy and others.")
         (line4 "XLISP-STAT Release 3.52.13 (Beta).")
         (line5 "Copyright (c) 1989-1999, by Luke Tierney.")
         )
    (setf *xls-copyright* 
          (format nil "~a~%~a~%~a~%~%~a~%~a~%"
                  line1 line2 line3 line4 line5))
    (list line1 line2 line3 "  " line4 line5)))

(defun xls-mod-copyright ()
    (let* ((line6 "XLISP-STAT for Windows Release 3.52.13.1 (Beta).")
           (line7 "Modified by Fabian Camacho and Forrest W. Young."))
      (setf *xls-mod-copyright* 
            (format nil "~a~%~a~%" line6 line7))
      (list line6 line7)))

(defun copyrights (&optional (print nil))
"ARG: (PRINT NIL)
Returns, and prints, when PRINT is T, all copyright notices. Returned value is a list of strings, prepared for twiddle presentation. Printed version is nicely formatted."
  (when print (format t "~%~a~%" *xls-copyright*))
  (when print (format t "~a" *xls-mod-copyright*))
  (combine (xls-copyright) " "
           (xls-mod-copyright) " "
           (make-vista-copyright)))


(defun viva-copyright ()
     (let* ((str1 "ViVa - ViSta's Interactive Variable Abacus")
            (str2 (format nil "Copyright (c) 1998-~a by Forrest W. Young"
                          (sixth (get-decoded-time-list)))))
       (setf *viva-copyright* (format nil "~a~%~a" str1 str2))
       (list str1 str2)))

(defun strcat (&rest args) (apply #'concatenate 'string args))

(defun get-file-length (filename)
     (with-open-file (f filename) (file-length f)))

(setf *source-files-length* 0)
  (setf *source-files-number* 0)


(defun make-core-files-list ()
  (setf *core-files*
        (combine (directory (strcat *default-path* "lspsrc\\*.lsp"))
                 (directory (strcat *default-path* "lispboss\\*.lsp"))
                 (remove 'nil
                         (mapcar #'(lambda (file)
                                     (strcat file ".lsp"))
                                 (combine
                                  (strcat *default-path* "init")
                                  (strcat *default-path* "init-functions")
                                  (strcat *default-path* "statinit")
                                  (map-elements #'strcat (strcat *default-path* "maketime\\") *make-files*)
                                  (map-elements #'strcat *source-path* *uncompileable-files*)
                                  (map-elements #'strcat *runtime-path* *special-files*)
                                  (map-elements #'strcat *source-path* *source-files*)
                                  (map-elements #'strcat *runtime-path* *runtime-files*))))
                 )))

(defun make-plugin-files-list ()
	(setf *plug-files*
        (combine (remove 'nil
            (mapcar #'(lambda (file) file)
        (combine
(directory (strcat *plugin-path* "*"))
(directory (strcat *plugin-path* "clustplg\\*.lsp"))
(directory (strcat *plugin-path* "crsplug\\*.lsp" ))
(directory (strcat *plugin-path* "freq\\*.lsp" ))
(directory (strcat *plugin-path* "homals\\*.lsp"))
(directory (strcat *plugin-path* "lglin\\*.lsp"))
(directory (strcat *plugin-path* "mamds\\*.lsp"))
(directory (strcat *plugin-path* "mmrplug\\*.lsp"))
(directory (strcat *plugin-path* "pcaplug\\*.lsp"))
(directory (strcat *plugin-path* "plugins-undistributed\\bootstrap\\*.lsp"))
(directory (strcat *plugin-path* "plugins-undistributed\\corkbord\\*.lsp"))
(directory (strcat *plugin-path* "plugins-undistributed\\mapaddon\\*.lsp"))
(directory (strcat *plugin-path* "plugins-undistributed\\multilevel\\*.lsp"))
(directory (strcat *plugin-path* "plugins-undistributed\\nrmds\\*.lsp"))
(directory (strcat *plugin-path* "plugins-undistributed\\olsreg\\*.lsp"))
(directory (strcat *plugin-path* "plugins-undistributed\\reliability\\*.lsp"))))))))


;(setf *core-files* (make-core-files-list))
;(setf *plug-files* (make-plugin-files-list))

(defun get-project-stats (part)
    (list
     (length part)
     (sum (remove 'nil (mapcar #'(lambda (file)
              	(when (probe-file file) (get-file-length file)))
          	(remove 'nil part))))))


(defun project-stats-dialog ()
   (setf *please-wait* (please-wait (project-stats-info)))
   (send *please-wait* :location (first (send *please-wait* :location)) 150)
   (send *please-wait* :size (first (send *please-wait* :size)) 50)
   (send *please-wait* :title "Project Stats")
   ;(setf *please-wait* nil)
   )
                      
(defun project-stats-info ()
  (let ((core-stats (project-stats "core") )
        (plug-stats (project-stats "plug")))
    (strcat (apply #'print-project-stats-line (combine "CORE" core-stats))
            (apply #'print-project-stats-line (combine "PLUG" plug-stats))
            (apply #'print-project-stats-line (combine "ALL " (+ core-stats plug-stats))))))

                         
(defun print-project-stats-line (type files chars boxes pages)
  (format nil "~a: ~d files, ~d characters, ~d listing pages.~%" 
          (STRING-UPCASE type) files chars pages))

(defun project-stats (type)
  (let* ((stats (if (equal type "core")
                    (get-project-stats (make-core-files-list))
                     (get-project-stats (make-plugin-files-list))))
         (files (first stats))
         (chars (second stats))
         (boxes (ceiling (/ chars (* 2000 40))))
         (pages (ceiling (/ chars (* 60 80)))))
    (list files chars boxes pages)))
                         